﻿Imports System.Threading
Imports System.Text
Imports System.Configuration
Imports System.Text.RegularExpressions

Public Class MyTasks
    Private ti As Timer
    Private logfile As String
    Private helper As Object
    Private _dbconfigname As String = "default"
    Private Shared _tasks As DataTable
    Private Shared _taskdetail As DataTable
    Private _errmessage As String
    Private _Interval As Long
    Private _enableddebug As Boolean = False
    Private _basepath As String


    Private _datagridview As Windows.Forms.DataGridView
    Private _pagebreak As String = "<div\s*style=\""page-break-after:\s*always(?:;)?\"">\s*(?:.+)<\/div>"


    ''' <summary>
    ''' 发布中的任务
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Property Tasks() As DataTable
        Get


            If _tasks Is Nothing Then
                _tasks = New DataTable
                _tasks.PrimaryKey = {_tasks.Columns.Add("id")}
                _tasks.Columns.Add("f_siteid")
                _tasks.Columns.Add("f_domain")
                _tasks.Columns.Add("f_masterid")
                _tasks.Columns.Add("f_mastername")
                _tasks.Columns.Add("f_catalog_guid")
                _tasks.Columns.Add("f_catalog_name")
                _tasks.Columns.Add("f_addtime")
                _tasks.Columns.Add("f_status")  '0等待,1加入队列中,2数据处理中,3生成文件,10成功,20失败
                _tasks.Columns.Add("f_createtime")
                _tasks.Columns.Add("f_starttime")
                _tasks.Columns.Add("f_endtime")
                _tasks.Columns.Add("f_waitsec")
                _tasks.Columns.Add("f_dealsec")
                _tasks.Columns.Add("f_count")
                _tasks.Columns.Add("f_sitepath")
                _tasks.Columns.Add("f_charset")
            End If
            Return _tasks
        End Get
        Set(ByVal value As DataTable)
            _tasks = value
        End Set
    End Property

    ''' <summary>
    ''' 发布中的任务明细表
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Property TaskDetails() As DataTable
        Get
            If _taskdetail Is Nothing Then
                _taskdetail = New DataTable
                _taskdetail.PrimaryKey = {_taskdetail.Columns.Add("id")}
                _taskdetail.Columns.Add("taskid")
                _taskdetail.Columns.Add("f_type")
                _taskdetail.Columns.Add("f_id")
                _taskdetail.Columns.Add("f_url")
                _taskdetail.Columns.Add("f_path")
                _taskdetail.Columns.Add("f_sitepath")
                _taskdetail.Columns.Add("f_isover")         '0未处理 1发布成功 2发布失败
                _taskdetail.Columns.Add("f_count")
                _taskdetail.Columns.Add("f_usesec")
                _taskdetail.Columns.Add("f_error")
                _taskdetail.Columns.Add("f_content_type")
                _taskdetail.Columns.Add("f_contentarray", System.Type.GetType("System.String[]"))
                _taskdetail.Columns.Add("f_labelconfig")

            End If
            Return _taskdetail
        End Get
        Set(ByVal value As DataTable)
            _taskdetail = value
        End Set
    End Property


    ''' <summary>
    ''' 任务事件委拖
    ''' </summary>
    ''' <param name="dr">数据行</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Delegate Function taskDelegate(ByVal dr As DataRow) As Integer


    ''' <summary>
    ''' 新任务事件
    ''' </summary>
    ''' <param name="dr"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function newTask(ByVal dr As DataRow) As Integer
        dr.Item("f_status") = 1

        '创建任务内容
        createTaskContent(dr)

        Dim taskid As String = dr.Item("id").ToString()


        '发布文件
        Dim dt As DateTime, labelconfig As String = String.Empty, errmessage As String = String.Empty
        Try
            SyncLock Tasks
                dr.Item("f_status") = 2
                dr.Item("f_starttime") = Now
                Dim basepath As String = dr.Item("f_sitepath")
                Dim charset As String = dr.Item("f_charset")
                SyncLock TaskDetails
                    For Each _detailrow As DataRow In TaskDetails.Select("f_isover<2 and taskid='" + dr.Item("id") + "'")
                        Dim id As String = _detailrow.Item("id")
                        dt = Now
                        errmessage = String.Empty
                        Dim spath As String = String.Empty, sitepath As String = String.Empty, icount As Integer, content() As String = {}
                        Try
                            labelconfig = IIf(IsDBNull(_detailrow.Item("f_labelconfig")), String.Empty, _detailrow.Item("f_labelconfig"))

                            If IsDBNull(_detailrow.Item("f_contentarray")) Then
                                errmessage = "没有生成任何发布信息"
                                _detailrow.Item("f_isover") = 2
                                updateDbTaskDetail(_detailrow.Item("id"), _detailrow.Item("f_usesec"), errmessage, String.Empty, labelconfig, sitepath, icount)
                                Continue For
                            End If

                            If IsDBNull(_detailrow.Item("f_path")) OrElse String.IsNullOrEmpty(_detailrow.Item("f_path")) Then
                                errmessage = "发布的路径或是内容为空"
                                _detailrow.Item("f_isover") = 2
                            Else
                                '内容数组处理
                                content = _detailrow.Item("f_contentarray")
                                If content Is Nothing Then
                                    _detailrow.Item("f_isover") = 2
                                    _detailrow.Item("f_error") = "未生成任何内容数组"
                                End If
                                icount = content.Length
                                For i As Integer = 0 To icount - 1
                                    If _detailrow.Item("f_isover") = 0 Then
                                        Dim path As String = _detailrow.Item("f_path")
                                        If Not IsDBNull(_detailrow.Item("f_sitepath")) Then
                                            sitepath = _detailrow.Item("f_sitepath")
                                        End If
                                        If path.StartsWith("/") Then
                                            spath = String.Concat(basepath, sitepath)
                                        Else
                                            sitepath = String.Empty
                                        End If
                                        If i > 0 Then
                                            If path.EndsWith("/") Then
                                                path = String.Concat(path, "default.html")
                                            End If
                                            path = String.Concat(IO.Path.GetDirectoryName(path), "/", IO.Path.GetFileNameWithoutExtension(path), "_", i, IO.Path.GetExtension(path))
                                        End If

                                        errmessage = CreateFile(path, content(i), labelconfig, spath, charset)
                                    End If
                                Next
                                If String.IsNullOrEmpty(errmessage) Then
                                    _detailrow.Item("f_isover") = 1
                                Else
                                    _detailrow.Item("f_isover") = 2
                                    _detailrow.Item("f_error") = errmessage
                                End If
                            End If

                        Catch ex As Exception
                            errmessage = ex.Message
                            tolog(String.Concat("newTask: id =", id, ":Exception :", errmessage))
                        End Try

                        _detailrow.Item("f_error") = errmessage
                        _detailrow.Item("f_usesec") = (Now() - dt).Milliseconds / 1000

                        If updateDbTaskDetail(id, _detailrow.Item("f_usesec"), errmessage, content(0), labelconfig, sitepath, icount) AndAlso String.IsNullOrEmpty(errmessage) Then
                            tolog(String.Concat("newTask: id = ", id, ": 任务发布成功"))
                        Else
                            tolog(String.Concat("newTask: id = ", id, ": " + errmessage))
                        End If
                    Next
                End SyncLock
            End SyncLock
        Catch ex As Exception
            dr.Item("f_status") = 20
            dr.Item("f_starttime") = Now
            tolog(String.Concat("newTask: taskid=", taskid, ": Exception:", ex.Message))
        End Try
        Return 2
    End Function

    ''' <summary>
    ''' 任务完成调用事件
    ''' </summary>
    ''' <param name="asyncResult"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function taskCallBack(ByVal asyncResult As IAsyncResult) As Integer
        '更新数据
        If (asyncResult.IsCompleted) Then
            Try
                SyncLock Tasks
                    Dim dr As DataRow = asyncResult.AsyncState
                    If Not dr Is Nothing AndAlso Not IsDBNull(dr.Item("id")) Then
                        '更新发布状态
                        updateDbTask(dr.Item("id").ToString, 9, dr.Item("f_createtime"), dr.Item("f_starttime"))
                        '移除发布队列
                        removeTask(dr)
                    End If
                End SyncLock

            Catch ex As Exception
                tolog(String.Concat("taskCallBack:", ex.Message))
            End Try
        End If
        Return 1
    End Function

    ''' <summary>
    ''' 0.开始任务事件
    ''' </summary>
    ''' <remarks></remarks>
    Public Sub StartTask()
        loadNewTasks()

        SyncLock Tasks
            For Each _dr As DataRow In Tasks.Rows
                '未处理的队列，创建任务
                If _dr.Item("f_status") = 0 Then
                    Dim task As taskDelegate = AddressOf newTask
                    Dim asyncResult As IAsyncResult = task.BeginInvoke(_dr, AddressOf taskCallBack, _dr)
                    _dr.Item("f_status") = 1
                    updateDbTask(_dr.Item("id"), 1, "", "")
                End If
            Next
        End SyncLock

    End Sub


    Private Sub UpadateDataGridView()
        'If Not _datagridview Is Nothing Then
        '    _datagridview.DataSource = Tasks
        '    _datagridview.Refresh()
        'End If
    End Sub


    ''' <summary>
    ''' 0.1从数据库中读取新任务
    ''' </summary>
    ''' <remarks></remarks>
    Public Sub loadNewTasks()
        Try
            Dim ds As New DataSet
            Dim i As Integer = 0
            Dim DataBase As New Data.DataFactory(_dbconfigname)
            If DataBase.ExecuteProduce("sp_cms_loadNewTasks", {}, ds, {"tasks", "taskdetails"}, True) <> -500 Then
                If Not ds.Tables("tasks") Is Nothing Then
                    For Each _dr As DataRow In ds.Tables("tasks").Rows
                        SyncLock Tasks
                            If Not Tasks.Rows.Contains(_dr.Item("id")) Then
                                'createTaskdetailsContent(_dr)
                                Tasks.ImportRow(_dr)
                                UpadateDataGridView()
                                If Not ds.Tables("taskdetails") Is Nothing Then
                                    For Each __dr As DataRow In ds.Tables("taskdetails").Select("taskid=" + _dr.Item("id").ToString)
                                        SyncLock TaskDetails
                                            __dr.Item("f_isover") = 0
                                            TaskDetails.ImportRow(__dr)
                                        End SyncLock
                                    Next
                                    i = i + 1
                                End If
                            End If
                        End SyncLock

                    Next
                    If i > 0 Then
                        tolog("新增" + i.ToString() + "个队列任务!!")
                    End If

                Else
                    tolog("sp_cms_loadNewTasks: tasks: NULL !!")
                End If

            Else
                tolog(DataBase.ErrMessage)
            End If
            DataBase = Nothing
        Catch ex As Exception
            tolog(String.Concat("loadNewTasks:", ex.Message))
        End Try
    End Sub

    ''' <summary>
    ''' 移除发布队列
    ''' </summary>
    ''' <param name="dr">数据行</param>
    ''' <remarks></remarks>
    Public Sub removeTask(ByVal dr As DataRow)
        Try
            SyncLock Tasks
                SyncLock TaskDetails
                    If Not String.IsNullOrEmpty(dr.Item("id")) Then

                        For Each _dr As DataRow In TaskDetails.Select("taskid=" + dr.Item("id").ToString())
                            TaskDetails.Rows.Remove(_dr)
                        Next

                    End If
                    Tasks.Rows.Remove(dr)
                    UpadateDataGridView()
                End SyncLock
            End SyncLock
        Catch ex As Exception
            tolog(String.Concat("removeTask:", ex.Message))
        End Try
    End Sub

    ''' <summary>
    ''' 更新发布记录数据库状态
    ''' </summary>
    ''' <param name="taskid">任务ID</param>
    ''' <param name="_status">状态值</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function updateDbTask(ByVal taskid As String, ByVal _status As Integer, ByVal createtime As String, ByVal starttime As String) As Integer
        Dim rtnVal As Integer
        Try
            Dim DataBase As New Data.DataFactory(_dbconfigname)
            rtnVal = DataBase.ExecuteFunction("sp_cms_publishupdatestatus", DataBase.ConvertParam({"taskid=" + taskid, "status=2", "createtime=" + createtime, "starttime=" + starttime}))
            If rtnVal = -500 Then
                Console.WriteLine(DataBase.ErrMessage)
            End If
            UpadateDataGridView()
            DataBase = Nothing
        Catch ex As Exception
            tolog(String.Concat("updateDbTask:", ex.Message))
        End Try

        Return rtnVal
    End Function

    ''' <summary>
    ''' 更新发布任务明细
    ''' </summary>
    ''' <param name="id">任务明细ID</param>
    ''' <param name="usesec">使用时间</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function updateDbTaskDetail(ByVal id As String, ByVal usesec As Long, ByVal err As String, ByVal content As String, ByVal labelconfig As String, ByVal sitepath As String, ByVal contentcount As Long) As Boolean
        Dim rtnVal As Integer
        Try

            Dim dbparams(7) As System.Data.Common.DbParameter
            Dim DataBase As New Data.DataFactory(_dbconfigname)
            dbparams(0) = DataBase.CreateParameter()
            dbparams(0).ParameterName = "id"
            dbparams(0).Value = id

            dbparams(1) = DataBase.CreateParameter()
            dbparams(1).ParameterName = "usesec"
            dbparams(1).Value = usesec

            dbparams(2) = DataBase.CreateParameter()
            dbparams(2).ParameterName = "err"
            dbparams(2).Value = err

            dbparams(3) = DataBase.CreateParameter()
            dbparams(3).ParameterName = "content"
            dbparams(3).DbType = DbType.String
            dbparams(3).Value = content

            dbparams(3) = DataBase.CreateParameter()
            dbparams(3).ParameterName = "labelconfig"
            dbparams(3).Value = labelconfig

            dbparams(4) = DataBase.CreateParameter()
            dbparams(4).ParameterName = "sitepath"
            dbparams(4).Value = sitepath

            dbparams(5) = DataBase.CreateParameter()
            dbparams(5).ParameterName = "contentcount"
            dbparams(5).Value = contentcount

            rtnVal = DataBase.ExecuteFunction("sp_cms_publishupdatedetailstatus", dbparams)
            If rtnVal = -500 Then
                tolog(String.Concat("updateDbTaskDetail:", DataBase.ErrMessage))
                Return False
            End If
            DataBase = Nothing
        Catch ex As Exception
            tolog(String.Concat("updateDbTaskDetail:", ex.Message))
            Return False
        End Try
        Return True
    End Function

    ''' <summary>
    ''' 2.创建发布队列内容
    ''' </summary>
    ''' <param name="dr">任务</param>
    ''' <remarks></remarks>
    Public Sub createTaskContent(ByRef dr As DataRow)
        Dim taskid As String = dr.Item("id").ToString()
        Try
            Dim type As String, id As String, contentid As String, ds_dr As DataRow, template_content As String
            Dim DataBase As New Data.DataFactory(_dbconfigname)

            SyncLock Tasks
                dr.Item("f_status") = 1
                dr.Item("f_createtime") = Now
                _basepath = dr.Item("f_sitepath")
                SyncLock TaskDetails
                    Dim drs As DataRow() = TaskDetails.Select("taskid='" + taskid + "'")
                    '读取队列明细
                    For Each _dr_details As DataRow In drs
                        type = _dr_details.Item("f_type").ToString()
                        contentid = _dr_details.Item("f_id").ToString()
                        id = _dr_details.Item("id").ToString()
                        Dim icount As Integer = 0, content() As String, ds As New DataSet("rows")
                        If DataBase.ExecuteProduce("sp_cms_publishcontent", DataBase.ConvertParam({"type=" + type, "id=" + contentid}), ds, "row", True) <> -500 Then
                            If ds Is Nothing Then
                                _dr_details.Item("f_error") = DataBase.ErrMessage
                                _dr_details.Item("f_isover") = 2
                            ElseIf ds.Tables.Count = 0 Then
                                _dr_details.Item("f_error") = "无法读取到sp_cms_publishcontent的内容表"
                                _dr_details.Item("f_isover") = 2
                            ElseIf ds.Tables(0).Rows.Count = 0 Then
                                _dr_details.Item("f_error") = "无法读取到sp_cms_publishcontent的数据行"
                                _dr_details.Item("f_isover") = 2
                            Else
                                ds_dr = ds.Tables("row").Rows(0)
                                Dim templatetype As String
                                If IsDBNull(ds_dr.Item("f_template_type")) Then
                                    templatetype = "html"
                                Else
                                    templatetype = ds_dr.Item("f_template_type").ToString.ToLower()
                                End If
                                _dr_details.Item("f_content_type") = templatetype

                                If IsDBNull(ds_dr.Item("f_template_content")) OrElse String.IsNullOrEmpty(ds_dr.Item("f_template_content")) Then
                                    '模板内容为空
                                    _dr_details.Item("f_error") = "无法读取模板内容"
                                    _dr_details.Item("f_isover") = 2
                                Else

                                    _dr_details.Item("f_sitepath") = ds_dr.Item("f_sitepath")
                                    template_content = ds_dr.Item("f_template_content").ToString()

                                    If templatetype = "xslt" Then
                                        If type = 2 Then
                                            '单篇文章内容分页处理
                                            content = xRegexSplit(ds_dr.Item("f_content"), _pagebreak)
                                            icount = content.Length
                                            '更新计数
                                            _dr_details.Item("f_count") = icount
                                            For i As Integer = 0 To icount - 1
                                                ds_dr.Item("f_content") = content(i)
                                                Dim xml As String = ds.GetXml()
                                                Dim xpdoc As New Xml.XPath.XPathDocument(New IO.StringReader(xml))
                                                If xpdoc Is Nothing Then
                                                    _dr_details.Item("f_error") = "XPathDocument Is Null."
                                                Else

                                                    Dim xsltarg As Xml.Xsl.XsltArgumentList = GetXsltArgList()
                                                    xsltarg.AddParam("domain", String.Empty, ds_dr.Item("f_domain"))
                                                    xsltarg.AddParam("rowcount", String.Empty, CStr(icount))
                                                    xsltarg.AddParam("maxrow", String.Empty, 1)
                                                    xsltarg.AddParam("curpage", String.Empty, (i + 1))

                                                    content(i) = dooll.Common.XsltCompiled.XmlTrans(xpdoc, template_content, xsltarg)
                                                    xsltarg = Nothing
                                                End If
                                            Next
                                            _dr_details.Item("f_contentarray") = content
                                        Else
                                            '栏目内容分页处理
                                            'content = ds_dr.Item("f_template_content")

                                            Dim pagesize As Decimal = IIf(IsDBNull(ds_dr.Item("f_pagesize")), 20, ds_dr.Item("f_pagesize"))
                                            Dim where As String = String.Concat("f_channel_id=", CStr(_dr_details.Item("f_id")))
                                            Dim orderby As String = "case when f_order is null then 1 else 0 end ,f_order ,f_addtime desc"

                                            Dim xpdoc As Xml.XPath.XPathDocument
                                            Dim iRowCount As Long = DataBase.XQuery("v_cms_article_top_20", pagesize, 1, "*", orderby, where, xpdoc)
                                            icount = Math.Ceiling(iRowCount / pagesize)

                                            Dim xsltarg As Xml.Xsl.XsltArgumentList = GetXsltArgList()
                                            xsltarg.RemoveParam("rowcount", String.Empty)
                                            xsltarg.AddParam("rowcount", String.Empty, CStr(iRowCount))

                                            xsltarg.RemoveParam("maxrow", String.Empty)
                                            xsltarg.AddParam("maxrow", String.Empty, CStr(pagesize))

                                            xsltarg.RemoveParam("curpage", String.Empty)
                                            xsltarg.AddParam("curpage", String.Empty, 1)

                                            xsltarg.RemoveParam("channelid", String.Empty)
                                            xsltarg.AddParam("channelid", String.Empty, CStr(ds_dr.Item("id")))

                                            xsltarg.RemoveParam("channelname", String.Empty)
                                            xsltarg.AddParam("channelname", String.Empty, CStr(ds_dr.Item("f_name")))

                                            xsltarg.RemoveParam("channelguid", String.Empty)
                                            xsltarg.AddParam("channelguid", String.Empty, CStr(ds_dr.Item("f_guid")))

                                            xsltarg.RemoveParam("channelpath", String.Empty)
                                            xsltarg.AddParam("channelpath", String.Empty, CStr(ds_dr.Item("f_path")))

                                            xsltarg.RemoveParam("channeldomain", String.Empty)
                                            xsltarg.AddParam("channeldomain", String.Empty, CStr(dr.Item("f_domain")))

                                            xsltarg.RemoveParam("orderby", String.Empty)
                                            xsltarg.AddParam("orderby", String.Empty, orderby)

                                            xsltarg.RemoveParam("where", String.Empty)
                                            xsltarg.AddParam("where", String.Empty, where)

                                            If icount = 0 Then
                                                ReDim content(0)
                                                content(0) = dooll.Common.XsltCompiled.XmlTrans(xpdoc, template_content, xsltarg)
                                            Else
                                                ReDim content(icount - 1)

                                                content(0) = dooll.Common.XsltCompiled.XmlTrans(xpdoc, template_content, xsltarg)
                                                For i As Integer = 1 To icount - 1

                                                    Dim curpage As Integer = i + 1

                                                    DataBase.XQuery("v_cms_article_top_20", pagesize, curpage, "*", orderby, where, xpdoc)

                                                    If iRowCount = -500 Then
                                                        _dr_details.Item("f_error") = DataBase.ErrMessage
                                                        _dr_details.Item("f_isover") = 2
                                                        Return
                                                    Else

                                                        xsltarg.RemoveParam("curpage", String.Empty)
                                                        xsltarg.AddParam("curpage", String.Empty, CStr(curpage))
                                                        content(i) = dooll.Common.XsltCompiled.XmlTrans(xpdoc, template_content, xsltarg)
                                                    End If
                                                Next
                                            End If
                                            '更新计数
                                            _dr_details.Item("f_count") = icount

                                            _dr_details.Item("f_contentarray") = content

                                        End If

                                    Else
                                        '普通HTML
                                        Dim sb As New StringBuilder(template_content)
                                        template_content = ReplaceCmsField(sb, ds_dr)
                                        template_content = ReplaceCmsLabel(sb, GetXsltArgList())
                                        _dr_details.Item("f_contentarray") = {sb.ToString()}
                                        sb = Nothing
                                    End If


                                    '数据配置
                                    _dr_details.Item("f_labelconfig") = ds_dr.Item("f_template_labelconfig")
                                End If
                            End If
                        Else
                            _dr_details.Item("f_error") = DataBase.ErrMessage
                            _dr_details.Item("f_isover") = 2
                        End If

                        If _dr_details.Item("f_isover") = 2 Then
                            tolog(String.Concat("createTaskContent: id =", id, ":", _dr_details.Item("f_error")))
                            updateDbTaskDetail(id, 0, _dr_details.Item("f_error"), String.Empty, String.Empty, String.Empty, icount)
                        Else
                            tolog(String.Concat("createTaskContent: id =", id, ":成功"))
                        End If

                    Next
                    drs = Nothing
                End SyncLock

            End SyncLock
            DataBase = Nothing
        Catch ex As Exception
            dr.Item("f_status") = 20
            dr.Item("f_starttime") = Now
            tolog(String.Concat("createTaskContent:", taskid, ":", ex.Message))
        End Try
    End Sub

    ''' <summary>
    ''' 日志
    ''' </summary>
    ''' <param name="s"></param>
    ''' <remarks></remarks>
    Private Sub tolog(ByVal s As String)
        Try
            Dim logfile As String = String.Concat(AppDomain.CurrentDomain.BaseDirectory, "\log\", DateTime.Today.ToString("yyyy-MM-dd"), ".txt")
            logfile = IO.Path.GetFullPath(logfile)
            Dim dir As String = IO.Path.GetDirectoryName(logfile)
            If Not IO.Directory.Exists(dir) Then
                IO.Directory.CreateDirectory(dir)
            End If
            s = String.Concat(Now.ToString("yyyy-MM-dd HH:mm:ss"), vbCrLf, "--------------------------------------------", vbCrLf, s, vbCrLf, "--------------------------------------------", vbCrLf)
            IO.File.AppendAllText(logfile, s)
        Catch ex As Exception
            Console.WriteLine(String.Concat(Now.ToString("yyyy-MM-dd HH:mm:ss "), ex.Message))
        End Try
    End Sub


#Region "功能区"



    Public Function CreateChannel(ByVal id As String, ByVal spath As String) As String
        Dim rtnValue As String = String.Empty, ds As New DataSet
        Try
            Dim DataBase As New Data.DataFactory(_dbconfigname)
            If DataBase.ExecuteProduce("sp_cms_publishcontent", DataBase.ConvertParam({"type=1", "id=" + id}), ds, "channel", True) <> -500 Then
                For Each dr As DataRow In ds.Tables("channel").Rows
                    If Not IsDBNull(dr.Item("f_template_content")) AndAlso Not String.IsNullOrEmpty(dr.Item("f_template_content")) Then
                        Dim template_content As String = dr.Item("f_template_content")
                        Dim sb As New StringBuilder(template_content)
                        template_content = ReplaceCmsField(sb, dr)
                        Dim _path As String = CStr(dr.Item("f_demopath"))
                        Dim _labelconfig As String = String.Empty
                        If Not IsDBNull(dr.Item("f_template_labelconfig")) Then
                            _labelconfig = CStr(dr.Item("f_template_labelconfig"))
                        End If
                        rtnValue = CreateFile(_path, template_content, _labelconfig, spath, dr.Item("f_charset"))
                    Else
                        rtnValue = String.Format("f_template_content内容为空。")
                    End If
                Next
            Else
                rtnValue = String.Format("sp_cms_publishcontent查无此[type=1;id={0}]记录", id)
            End If
            DataBase = Nothing
        Catch ex As Exception
            tolog(String.Concat("CreateChanel:", ex.Message))
            rtnValue = ex.Message
        End Try
        Return rtnValue
    End Function

    Public Shared Function CreateFile(ByVal vpath As String, ByVal _content As String, ByVal _labelconfig As String, ByVal _basepath As String, charset As String) As String
        Try
            Dim path As String = IO.Path.GetFullPath(String.Concat(_basepath, vpath))
            Dim ext As String = IO.Path.GetExtension(path)
            If LCase(ext) <> ".html" Then
                path = String.Concat(path, "/default.html")
            End If
            Dim err As String = String.Empty
            err = CreateFile(path, _content, charset)

            If Not String.IsNullOrEmpty(err) Then
                Return err
            End If
            If Not String.IsNullOrEmpty(_labelconfig) Then
                Dim labelpath As String = String.Concat(IO.Path.GetDirectoryName(path), "/", IO.Path.GetFileNameWithoutExtension(path), "/label.config")
                err = CreateFile(labelpath, _labelconfig, charset)
                If Not String.IsNullOrEmpty(err) Then
                    Return err
                End If
            End If

        Catch ex As Exception

            Return ex.Message
        End Try
        Return String.Empty
    End Function

    Public Shared Function CreateFile(ByVal path As String, ByVal content As String, charset As String) As String
        Try
            Dim dir As String = IO.Path.GetDirectoryName(path)

            If Not IO.Directory.Exists(dir) Then
                IO.Directory.CreateDirectory(dir)
            End If

            If String.IsNullOrEmpty(charset) Then
                charset = "utf-8"
            End If
            IO.File.WriteAllText(path, content, Encoding.GetEncoding(charset))
            Return String.Empty
        Catch ex As Exception
            Return ex.Message
        End Try

    End Function


    ''' <summary>
    ''' 替换CMS标签
    ''' </summary>
    ''' <param name="sb">字符串词组</param>
    ''' <param name="xsltarg"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function ReplaceCmsLabel(ByRef sb As StringBuilder, ByVal xsltarg As System.Xml.Xsl.XsltArgumentList) As String
        If xsltarg Is Nothing Then
            xsltarg = New Xml.Xsl.XsltArgumentList
        End If
        Try

            Dim options As RegexOptions = RegexOptions.IgnoreCase
            Dim fnMatchs As MatchCollection
            fnMatchs = Regex.Matches(sb.ToString, "<cms_(?<name>pictop|top|article|channel|module|preview|html)([^>]*)>(?<value>[^<]*)</cms_\k<name>>", options)

            For Each m As Match In fnMatchs
                Select Case m.Groups.Item("name").Value
                    Case "pictop"
                        Dim pictop As cms_pictop
                        pictop = CType(Common.Serialization.DeSerialize((New cms_pictop).GetType(), LCase(m.Value)), cms_pictop)
                        If pictop Is Nothing OrElse String.IsNullOrEmpty(pictop.channelid) Then
                            Return String.Empty
                        End If
                        sb.Replace(m.Value, ConvertCmsPicTop(pictop, xsltarg))
                    Case "top"
                        Dim top As cms_top
                        top = CType(Common.Serialization.DeSerialize((New cms_top).GetType(), LCase(m.Value)), cms_top)
                        If top Is Nothing OrElse String.IsNullOrEmpty(top.channelid) Then
                            Return String.Empty
                        End If
                        sb.Replace(m.Value, ConvertCmsTop(top, xsltarg))
                    Case "article"
                        Dim article As cms_article
                        article = CType(Common.Serialization.DeSerialize((New cms_article).GetType(), LCase(m.Value)), cms_article)
                        If article Is Nothing OrElse String.IsNullOrEmpty(article.channel) Then
                            Return String.Empty
                        End If
                        sb.Replace(m.Value, ConvertCmsArticle(article, xsltarg))
                    Case "channel"
                        Dim channel As cms_channel
                        channel = CType(Common.Serialization.DeSerialize((New cms_channel).GetType(), LCase(m.Value)), cms_channel)

                        If channel Is Nothing OrElse String.IsNullOrEmpty(channel.name) Then
                            Return String.Empty
                        End If
                        sb.Replace(m.Value, ConvertCmsChannel(channel, xsltarg))
                    Case "html"
                        Dim htmlcontent As cms_html
                        htmlcontent = CType(Common.Serialization.DeSerialize((New cms_html).GetType(), LCase(m.Value)), cms_html)
                        sb.Replace(m.Value, xCmsArticleContent(htmlcontent.id))
                    Case "module"
                        sb.Replace(m.Value, ConvertCmsModule(m.Groups.Item("value").Value))
                End Select

            Next

        Catch ex As Exception
            tolog(String.Concat("ReplaceCmsLabel:", ex.Message))
        End Try
        Return sb.ToString
    End Function

    ''' <summary>
    ''' 读取 cms_pictop 标签
    ''' </summary>
    ''' <param name="article"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function ConvertCmsTop(ByVal article As cms_top, ByVal XsltArgList As System.Xml.Xsl.XsltArgumentList) As String
        Try
            Dim params As String()
            Dim DataBase As New Data.DataFactory(_dbconfigname)

            '多篇文章
            Dim xpdoc As System.Xml.XPath.XPathDocument
            If IsNumeric(article.channelid) Then
                params = {"rows=" + CStr(article.rows), "channelid=" + CStr(article.channelid)}
            Else
                params = {"rows=" + CStr(article.rows), "channel=" + article.channel}
            End If

            If DataBase.ExecuteProduce("sp_cms_articletoppublish", DataBase.ConvertParam(params), xpdoc) = -500 Then
                Return DataBase.ErrMessage
            Else
                XsltArgList.RemoveParam("param", String.Empty)
                XsltArgList.AddParam("param", String.Empty, article.param)
                Return dooll.Common.XsltCompiled.XmlTrans(xpdoc, loadCmsModule(article.smodule), XsltArgList)
            End If
            xpdoc = Nothing

            DataBase = Nothing
        Catch ex As Exception
            tolog(String.Concat("ConvertCmsTop:", ex.Message))
            Return ex.Message
        End Try
    End Function

    ''' <summary>
    ''' 读取 cms_pictop 标签
    ''' </summary>
    ''' <param name="article"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function ConvertCmsPicTop(ByVal article As cms_pictop, ByVal XsltArgList As System.Xml.Xsl.XsltArgumentList) As String
        Try
            Dim params As String()
            Dim DataBase As New Data.DataFactory(_dbconfigname)

            '多篇文章
            Dim xpdoc As System.Xml.XPath.XPathDocument
            If IsNumeric(article.channelid) Then
                params = {"rows=" + CStr(article.rows), "channelid=" + CStr(article.channelid)}
            Else
                params = {"rows=" + CStr(article.rows), "channel=" + article.channel}
            End If
            If DataBase.ExecuteProduce("sp_cms_articlepictoppublish", DataBase.ConvertParam(params), xpdoc) = -500 Then
                Return DataBase.ErrMessage
            Else
                XsltArgList.RemoveParam("param", String.Empty)
                XsltArgList.AddParam("param", String.Empty, article.param)
                Return dooll.Common.XsltCompiled.XmlTrans(xpdoc, loadCmsModule(article.smodule), XsltArgList)
            End If
            xpdoc = Nothing

            DataBase = Nothing
        Catch ex As Exception
            tolog(String.Concat("ConvertCmsPicTop:", ex.Message))
            Return ex.Message
        End Try
    End Function


    ''' <summary>
    ''' 读取 cms_article 标签
    ''' </summary>
    ''' <param name="article"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function ConvertCmsArticle(ByVal article As cms_article, ByVal XsltArgList As System.Xml.Xsl.XsltArgumentList) As String
        Try
            Dim params As String()
            Dim DataBase As New Data.DataFactory(_dbconfigname)

            If article.id > 0 Then
                '单篇文章
                Dim ds As New DataSet("rows")

                Dim spname As String
                If article.preview Then
                    spname = "sp_cms_articlecontent"
                    params = {String.Concat("id=", article.id)}
                Else
                    spname = "sp_cms_publishcontent"
                    params = {"type=2", String.Concat("id=", article.id)}
                End If
                If DataBase.ExecuteProduce(spname, DataBase.ConvertParam(params), ds, "row") <> -500 Then
                    If Not ds Is Nothing Then
                        If ds.Tables(0).Rows.Count = 0 Then
                            Return "查无此文章"
                        Else
                            Dim ds_dr As DataRow = ds.Tables(0).Rows(0)
                            If Not IsDBNull(ds_dr.Item("f_template_content")) Then
                                Dim xslt = ds_dr.Item("f_template_content")
                                ds_dr.Item("f_template_content") = String.Empty
                                ds_dr.Item("f_template_labelconfig") = String.Empty

                                Dim xml As String = ds.GetXml()
                                Dim xpdoc As New Xml.XPath.XPathDocument(New IO.StringReader(xml))
                                If xpdoc Is Nothing Then
                                    Return "XPathDocument Is Null."
                                Else
                                    Return dooll.Common.XsltCompiled.XmlTrans(xpdoc, xslt, XsltArgList)
                                End If
                            Else
                                Return "无此细览模板"
                            End If
                        End If
                    Else
                        Return DataBase.ErrMessage
                    End If
                Else
                    Return DataBase.ErrMessage
                End If
                ds = Nothing
            Else
                '多篇文章
                Dim xpdoc As System.Xml.XPath.XPathDocument
                params = {"rows=" + CStr(article.rows), "channel=" + article.channel}
                If DataBase.ExecuteProduce("sp_cms_articletoppublish", DataBase.ConvertParam(params), xpdoc) = -500 Then
                    Return DataBase.ErrMessage
                Else
                    XsltArgList.RemoveParam("param", String.Empty)
                    XsltArgList.AddParam("param", String.Empty, article.param)
                    Return dooll.Common.XsltCompiled.XmlTrans(xpdoc, loadCmsModule(article.smodule), XsltArgList)
                End If
                xpdoc = Nothing
            End If
            DataBase = Nothing
        Catch ex As Exception
            tolog(String.Concat("ConvertCmsArticle:", ex.Message))
            Return ex.Message
        End Try
    End Function

    ''' <summary>
    ''' 转换cms_channel标签
    ''' </summary>
    ''' <param name="channel"></param>
    ''' <param name="XsltArgList"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function ConvertCmsChannel(ByVal channel As cms_channel, ByVal XsltArgList As System.Xml.Xsl.XsltArgumentList) As String
        Try
            Dim xpdoc As System.Xml.XPath.XPathDocument
            Dim fnStartTime As DateTime = DateTime.Now
            Dim where As String = "f_channel_id = '" + CStr(channel.id) + "'"
            Dim DataBase As New Data.DataFactory(_dbconfigname)
            Dim iRowCount As Long = DataBase.XQuery("v_cms_article_top_20", channel.pagesize, channel.curpage, "*", channel.orderby, where, xpdoc)
            If iRowCount = -500 Then
                Return DataBase.ErrMessage
            Else
                XsltArgList.RemoveParam("rowcount", String.Empty)
                XsltArgList.AddParam("rowcount", String.Empty, CStr(iRowCount))

                XsltArgList.RemoveParam("maxrow", String.Empty)
                XsltArgList.AddParam("maxrow", String.Empty, CStr(channel.pagesize))

                XsltArgList.RemoveParam("curpage", String.Empty)
                XsltArgList.AddParam("curpage", String.Empty, CStr(channel.curpage))

                XsltArgList.RemoveParam("templatename", String.Empty)
                XsltArgList.AddParam("templatename", String.Empty, channel.name)

                XsltArgList.RemoveParam("orderby", String.Empty)
                XsltArgList.AddParam("orderby", String.Empty, channel.orderby)

                XsltArgList.RemoveParam("where", String.Empty)
                XsltArgList.AddParam("where", String.Empty, where)

                XsltArgList.RemoveParam("runtime", String.Empty)
                XsltArgList.AddParam("runtime", String.Empty, CStr((DateTime.Now - fnStartTime).TotalMilliseconds / 1000))
                Dim xslt As String = loadCmsModule(channel.smodule)
                If String.IsNullOrEmpty(xslt) Then
                    Return String.Format("Module.{0} 没有返回任何信息.", channel.smodule)
                End If
                Return dooll.Common.XsltCompiled.XmlTrans(xpdoc, xslt, XsltArgList)
            End If
        Catch ex As Exception
            tolog(String.Concat("ConvertCmsChannel:", ex.Message))
            Return ex.Message
        End Try
    End Function

    ''' <summary>
    ''' 读取xslt模块
    ''' </summary>
    ''' <param name="mName"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function loadCmsModule(ByVal mName As String) As String
        If String.IsNullOrEmpty(mName) Then
            mName = "default"
        End If
        Dim rtnValue As String = String.Empty
        Dim DataBase As New Data.DataFactory(_dbconfigname)
        If DataBase.ExecuteScalar("sp_cms_moduleselect", DataBase.ConvertParam({"key=" + mName}), rtnValue) = -500 Then
            Return String.Empty
        End If
        DataBase = Nothing
        Return rtnValue
    End Function

    ''' <summary>
    ''' 读取xslt模块
    ''' </summary>
    ''' <param name="mName"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function ConvertCmsModule(ByVal mName As String) As String
        If String.IsNullOrEmpty(mName) Then
            mName = "default"
        End If
        Dim rtnValue As String = String.Empty
        Dim DataBase As New Data.DataFactory(_dbconfigname)
        Dim ds As New DataSet
        If DataBase.ExecuteProduce("sp_cms_moduleselect", DataBase.ConvertParam({"key=" + mName}), ds, "rows", True) <> -500 Then
            For Each dr As DataRow In ds.Tables("rows").Rows
                rtnValue = dr.Item("f_content")
                Dim type As String = dr.Item("f_type")
                If LCase(type) = "xslt" Then
                    rtnValue = Common.XsltCompiled.XmlTrans(New System.Xml.XPath.XPathDocument(New IO.StringReader("<rows/>")), rtnValue, GetXsltArgList())
                End If
            Next
        End If
        DataBase = Nothing
        Return rtnValue
    End Function

    Public Function ReplaceCmsField(ByRef sb As Text.StringBuilder, ByVal ds As DataSet) As String
        Return ReplaceCmsField(sb, ds.Tables(0))
    End Function

    Public Overridable Function ReplaceCmsField(ByRef sb As Text.StringBuilder, ByVal dt As DataTable) As String
        Return ReplaceCmsField(sb, dt.Rows(0))
    End Function

    Public Overridable Function ReplaceCmsField(ByRef sb As Text.StringBuilder, ByVal dr As DataRow) As String
        Try
            Dim fnMatchs As MatchCollection = Regex.Matches(sb.ToString, "<cms_field>(?<name>[^<]+)</cms_field>", RegexOptions.IgnoreCase)
            Dim fieldname As String
            For Each m As Text.RegularExpressions.Match In fnMatchs
                fieldname = m.Groups("name").Value
                If Not String.IsNullOrEmpty(fieldname) AndAlso Not dr.Item(fieldname) Is Nothing Then
                    sb.Replace(m.Value, CStr(dr.Item(fieldname)))
                End If
            Next
        Catch ex As Exception
            tolog(String.Concat("ReplaceCmsField:", ex.Message))
        End Try
        Return sb.ToString
    End Function

    ''' <summary>
    ''' 创建发布管理器
    ''' </summary>
    ''' <param name="dbconfigname"></param>
    ''' <remarks></remarks>
    Public Sub New(dbconfigname As String)

        _dbconfigname = dbconfigname

    End Sub

    Protected Overrides Sub Finalize()
        MyBase.Finalize()
    End Sub


    ''' <summary>
    ''' xslt文件包含
    ''' </summary>
    ''' <param name="f">文件名</param>
    ''' <returns>包含文件</returns>
    ''' <remarks></remarks>
    Public Function xInclude(ByVal f As String) As String
        Return xInclude(f, String.Empty)
    End Function

    ''' <summary>
    ''' xslt文件包含
    ''' </summary>
    ''' <param name="f">文件名</param>
    ''' <param name="param">附加参数值</param>
    ''' <returns>包含文件</returns>
    ''' <remarks></remarks>
    Public Function xInclude(ByVal f As String, ByVal param As String) As String
        f = String.Concat(_basepath, f)

        If Not IO.File.Exists(f) Then
            Return String.Format("{0}文件不存在", f)
        End If
        Dim RtnValue As String
        If f.EndsWith(".xsl") Then
            Dim XsltArgList As System.Xml.Xsl.XsltArgumentList = GetXsltArgList()
            XsltArgList.AddParam("param", String.Empty, param)
            RtnValue = Common.XsltCompiled.XmlTrans(New System.Xml.XPath.XPathDocument(New IO.StringReader("<rows/>")), XsltArgList, f)
            XsltArgList = Nothing
        Else

            Dim html As String = IO.File.ReadAllText(f, Encoding.UTF8)
            RtnValue = html.Replace("{param}", param)
        End If

        Return RtnValue
    End Function

    ''' <summary>
    ''' 条件判断
    ''' </summary>
    ''' <param name="b">条件表达式</param>
    ''' <param name="ts">结果真</param>
    ''' <param name="fs">结果假</param>
    ''' <returns>条件判断结果</returns>
    ''' <remarks></remarks>
    Public Function xIIF(ByVal b As Boolean, ByVal ts As String, ByVal fs As String) As String
        Return CStr(IIf(b, ts, fs))
    End Function

    ''' <summary>
    ''' xslt 分拆函数
    ''' </summary>
    ''' <param name="f">字符串</param>
    ''' <param name="c">分隔符</param>
    ''' <param name="n">索引值</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function xSplit(ByVal f As String, ByVal c As String, ByVal n As Integer) As String
        Dim a As String() = f.Split(CChar(c))
        If n >= a.Length Then
            Return String.Empty
        End If
        If String.IsNullOrEmpty(a(n)) Then
            Return String.Empty
        End If
        Return a(n)
    End Function


    ''' <summary>
    ''' split 分拆成xpath
    ''' </summary>
    ''' <param name="f"></param>
    ''' <param name="c"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function xXmlSplit(ByVal f As String, ByVal c As String) As System.Xml.XPath.XPathNavigator
        Dim a As String() = f.Split(CChar(c))
        Try
            Dim ser As New System.Xml.Serialization.XmlSerializer(a.GetType(), New System.Xml.Serialization.XmlRootAttribute("array"))
            Dim mem As New IO.MemoryStream
            ser.Serialize(mem, a)
            Dim xmlstr As String = Encoding.UTF8.GetString(mem.ToArray())
            mem.Close()
            mem = Nothing
            Dim doc As New System.Xml.XmlDocument()
            doc.LoadXml(xmlstr)
            Return doc.CreateNavigator
        Catch ex As Exception
            Return xmlpath(String.Concat("<array><err><![CDATA[", ex.ToString(), "]]></err></array>"))
        End Try

    End Function

    ''' <summary>
    ''' 动态执行程序
    ''' </summary>
    ''' <param name="spName">存储过程</param>
    ''' <param name="params">参数</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function xExec(spName As String, params As String) As System.Xml.XPath.XPathNavigator
        params = String.Concat("|", params)
        Dim xpath As System.Xml.XPath.XPathDocument = Nothing
        Dim DataBase As New Data.DataFactory(_dbconfigname)
        If DataBase.ExecuteProduce(spName, params.Split(CChar("|")), xpath) = -500 Then
            Return xmlpath(String.Concat("<rows><err><![CDATA[", DataBase.ErrMessage, "]]></err></rows>"))
        End If

        Return xpath.CreateNavigator()
    End Function

    Public Function xmlpath(rootName As String) As System.Xml.XPath.XPathNavigator
        Dim doc As New System.Xml.XmlDocument()
        doc.LoadXml(rootName)
        Return doc.CreateNavigator
    End Function


    ''' <summary>
    ''' xslt 正则分拆函数
    ''' </summary>
    ''' <param name="f">字符串</param>
    ''' <param name="c">分隔符</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function xRegexSplit(ByVal f As String, ByVal c As String) As String()
        Try
            Return Regex.Split(f, c, RegexOptions.IgnoreCase)
        Catch ex As Exception
            Return {}
        End Try
    End Function

    ''' <summary>
    ''' xslt 正则分拆函数
    ''' </summary>
    ''' <param name="f">字符串</param>
    ''' <param name="c">分隔符</param>
    ''' <param name="n">索引值</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function xRegexSplit(ByVal f As String, ByVal c As String, ByVal n As Integer) As String
        Return xRegexSplit(f, c)(n)
    End Function

    ''' <summary>
    ''' URL编码
    ''' </summary>
    ''' <param name="f">文件名</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function xEncodeURI(ByVal f As String) As String
        Return System.Uri.EscapeUriString(f)
    End Function


    ''' <summary>
    ''' 格式化时间
    ''' </summary>
    ''' <param name="s">字符串格式的时间</param>
    ''' <param name="f">指定的格式</param>
    ''' <returns>返回指定式的时间</returns>
    ''' <remarks>如果转换失败就返回原时间</remarks>
    Public Function xDateFormat(ByVal s As String, f As String) As String
        Dim dt As New DateTime
        If DateTime.TryParse(s, dt) Then
            Return dt.ToString(f)
        Else
            Return s
        End If
    End Function

    ''' <summary>
    ''' 增加时间
    ''' </summary>
    ''' <param name="dts">时间</param>
    ''' <param name="day">新增的天数</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function xAddDay(dts As String, day As Integer) As String
        Dim dt As Date = Convert.ToDateTime(dts)
        Return dt.AddDays(day).ToString("yyyy-MM-dd")
    End Function

    ''' <summary>
    ''' 月初
    ''' </summary>
    ''' <param name="dts"></param>
    ''' <param name="months"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function xMonthBegin(dts As String, months As Integer) As String
        Dim dt As Date = Convert.ToDateTime(dts)
        dt = dt.AddMonths(months)
        Dim newdt As Date = New System.DateTime(dt.Year, dt.Month, 1)
        Return newdt.ToString("yyyy-MM-dd")
    End Function

    ''' <summary>
    ''' 月初
    ''' </summary>
    ''' <param name="dts"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function xMonthBegin(dts As String) As String
        Return xMonthBegin(dts, 0)
    End Function

    ''' <summary>
    ''' 月底
    ''' </summary>
    ''' <param name="dts"></param>
    ''' <param name="months"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function xMonthEnd(dts As String, months As Integer) As String
        Dim dt As Date = Convert.ToDateTime(dts)
        dt = dt.AddMonths(months)
        Dim newdt As Date = New System.DateTime(dt.Year, dt.Month, 1)
        Return newdt.AddMonths(1).AddDays(-1).ToString("yyyy-MM-dd")
    End Function

    ''' <summary>
    ''' 月底
    ''' </summary>
    ''' <param name="dts"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function xMonthEnd(dts As String) As String
        Return xMonthEnd(dts, 0)
    End Function

    ''' <summary>
    ''' 是否匹配
    ''' </summary>
    ''' <param name="f">输入字符串</param>
    ''' <param name="p">正则表达式</param>
    ''' <returns>是否匹配</returns>
    ''' <remarks></remarks>
    Public Function xMatch(ByVal f As String, ByVal p As String) As Boolean
        Return Regex.IsMatch(f, p, RegexOptions.IgnoreCase)
    End Function

    ''' <summary>
    ''' 加载CMS数据库模块
    ''' </summary>
    ''' <param name="name"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function xLoadCmsModule(ByVal name As String) As String
        Return loadCmsModule(name)
    End Function

    Public Overridable Function xCmsArticle(ByVal channel As String) As String
        Return xCmsArticle(channel, 10, "default")
    End Function

    Public Overridable Function xCmsArticle(ByVal channel As String, ByVal rows As Integer) As String
        Return xCmsArticle(channel, rows, "default")
    End Function

    Public Overridable Function xCmsArticle(ByVal channel As String, ByVal rows As Integer, ByVal _module As String) As String
        Dim article As New cms_article
        article.channel = channel
        article.rows = rows
        article.smodule = _module
        Dim returnValue As String = String.Empty
        returnValue = ConvertCmsArticle(article, GetXsltArgList())
        Return returnValue
    End Function
    ''' <summary>
    ''' 左取字符
    ''' </summary>
    ''' <param name="str"></param>
    ''' <param name="length"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function xLeft(str As String, length As Integer) As String
        Return xSubString(str, 0, length)
    End Function

    ''' <summary>
    ''' 截取字段
    ''' </summary>
    ''' <param name="str"></param>
    ''' <param name="start"></param>
    ''' <param name="length"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function xSubString(str As String, start As Integer, length As Integer) As String
        Dim temp As String = str
        Dim j As Integer = 0
        Dim k As Integer = 0
        For i As Integer = 0 To str.Length - 1
            If Regex.IsMatch(temp.Substring(i, 1), "[\u4e00-\u9fa5]+") Then
                j += 2
            Else
                j += 1
            End If
            If j <= length Then
                k += 1
            End If
            If j >= length Then
                Return temp.Substring(start, k)
            End If
        Next
        Return temp
    End Function

    ''' <summary>
    ''' 替换CMS 标签
    ''' </summary>
    ''' <param name="s"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function xReplaceCmsLabel(s As String) As String
        Return ReplaceCmsLabel(New StringBuilder(s), GetXsltArgList())
    End Function


    Public Function xCmsArticleTop(ByVal channelid As Integer) As String
        Return xCmsArticleTop(channelid, 10, String.Empty, "default")
    End Function

    Public Function xCmsArticleTop(ByVal channelid As Integer, ByVal rows As Integer) As String
        Return xCmsArticleTop(channelid, rows, String.Empty, "default")
    End Function

    Public Function xCmsArticleTop(ByVal channelid As Integer, ByVal rows As Integer, param As String, ByVal _module As String) As String
        Dim article As New cms_top
        article.channelid = channelid
        article.rows = rows
        article.smodule = _module
        article.param = param
        Dim returnValue As String = String.Empty
        returnValue = ConvertCmsTop(article, Me.GetXsltArgList())
        Return returnValue
    End Function


    Public Function xCmsArticlePicTop(ByVal channelid As Integer) As String
        Return xCmsArticlePicTop(channelid, 10, String.Empty, "default")
    End Function

    Public Function xCmsArticlePicTop(ByVal channelid As Integer, ByVal rows As Integer) As String
        Return xCmsArticlePicTop(channelid, rows, String.Empty, "default")
    End Function

    Public Function xCmsArticlePicTop(ByVal channelid As Integer, ByVal rows As Integer, param As String, ByVal _module As String) As String
        Dim article As New cms_pictop
        article.channelid = channelid
        article.rows = rows
        article.smodule = _module
        article.param = param
        Dim returnValue As String = String.Empty
        returnValue = ConvertCmsPicTop(article, Me.GetXsltArgList())
        Return returnValue
    End Function


    ''' <summary>
    ''' 文章内容
    ''' </summary>
    ''' <param name="id"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function xCmsArticleContent(id As Integer) As String
        Dim params As String() = {"id=" + CStr(id)}
        Dim DataBase As New Data.DataFactory(_dbconfigname)
        Dim str As String = String.Empty
        If DataBase.ExecuteScalar("sp_cms_articlehtmlcontent", DataBase.ConvertParam(params), str) = -500 Then
            str = DataBase.ErrMessage
        End If
        Return str
    End Function


    ''' <summary>
    ''' 创建一个xslt参数列表对象
    ''' </summary>
    ''' <param name="ht">附加参数,Hashtable对象</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Protected Function GetXsltArgList(Optional ByVal ht As Hashtable = Nothing) As System.Xml.Xsl.XsltArgumentList

        If ht Is Nothing Then ht = New Hashtable
        Dim XsltArgList As New System.Xml.Xsl.XsltArgumentList
        XsltArgList.RemoveExtensionObject("urn:page")
        XsltArgList.AddExtensionObject("urn:page", Me)
        For Each de As DictionaryEntry In ht
            XsltArgList.RemoveParam(CStr(de.Key), String.Empty)
            XsltArgList.AddParam(CStr(de.Key), String.Empty, de.Value)
        Next
        Return XsltArgList
    End Function

#End Region

End Class

